home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 008a / feb93cad.zip / ATTEXTED.LSP < prev    next >
Lisp/Scheme  |  1993-02-12  |  8KB  |  242 lines
  1. ;ATTEXTED.LSP
  2. ;Program by Rolando Padron 3/19/91 Revised 5/2/91
  3. ;
  4. ;This routine allows the user to create a selection set of blocks 
  5. ;containing attribute text and edit the text using an ASCII text editor.
  6. ;The program will work with all, but constant attributes.
  7. ;
  8. ;You must modify your ACAD.PGP file prior to starting up AutoCAD as follows:
  9. ;EDATXT,<EDIT.EXE> ATTEXTED.FIL,XXXXXX,,4
  10. ;where <EDIT.EXE> is the command to start your  ASCII text editor and XXXXXX
  11. ;is the amount of memory required in the shell to load and run the editor.
  12. ;
  13. (defun c:attexted ( / ss-ctr at-sslgth etemp elist etemp2 elist2 etemp3
  14.                       elist3 bk-str ctr etemp-bk bk-name bk-ctr att-prmt
  15.                       att-str at-val ss1 at-fil cmd-ex olderr)
  16.    (errset)
  17.    (f-test)
  18.    (s1)
  19.    (at-ss)
  20.    (bk-tst)
  21.    (setq ss-ctr 0)
  22.    (prompt "\nWriting file. . .")
  23.    (while (< ss-ctr at-sslgth)
  24.       (setq etemp-bk nil)
  25.       (prompt " .")
  26.       (bk-info)
  27.       (setq bk-ctr 0
  28.             etemp3 (entnext etemp)
  29.             elist3 (entget (entnext etemp))
  30.       )
  31.       (while (and (= "ATTRIB" (dxf 0 elist3)) (/= "SEQEND" (dxf 0 elist3)))
  32.          (setq bk-ctr (1+ bk-ctr)
  33.                etemp3 (entnext etemp3)
  34.                elist3 (entget etemp3)
  35.          )
  36.           (if (= bk-ctr 1) (bk-prn))
  37.           (if (= ctr nil) (setq ctr 0))
  38.           (while (< ctr bk-ctr)
  39.              (at-info)
  40.              (at-value)
  41.              (at-file)
  42.              (setq ctr (1+ ctr))
  43.           )
  44.       )
  45.       (setq ss-ctr (1+ ss-ctr)
  46.             ctr nil
  47.             etemp2 nil
  48.       )
  49.    )
  50.    (command "EDATXT")
  51.    (prompt "\nUpdating text . . .")
  52.    (at-fix)
  53.    (command "DEL" "attexted.fil")
  54.    (graphscr)
  55.    (setq ss-ctr 0)
  56.    (while (< ss-ctr at-sslgth)
  57.       (prompt " .")
  58.       (entupd (ssname ss1 ss-ctr))
  59.       (setq ss-ctr (1+ ss-ctr))
  60.    )
  61.    (s2)
  62.    (err-b4)
  63.    (princ)
  64. )
  65. ;---------------------------------AT-SS---------------------------------------
  66. (defun at-ss ()
  67.    (prompt "\n Select BLOCKS with attributes for editing:  ")
  68.    (setq ss1 (ssget)
  69.          at-sslgth (sslength ss1)
  70.          ss-ctr 0
  71.    )
  72. )
  73. ;--------------------------------BK-INFO--------------------------------------
  74. (defun bk-info ()
  75.    (setq etemp (ssname ss1 ss-ctr)
  76.          elist (entget etemp)
  77.          bk-name (dxf 2 (entget etemp))
  78.          bk-str (strcat "***Block Name:  " bk-name)
  79.    )
  80. )
  81. ;--------------------------------BK-PRN---------------------------------------
  82. (defun bk-prn ()
  83.    (setq at-fil (open "attexted.fil" "a"))
  84.    (write-line bk-str at-fil)
  85.    (close at-fil)
  86. )
  87. ;--------------------------------AT-INFO--------------------------------------
  88. (defun at-info ()
  89.    (if (= etemp-bk nil)
  90.       (setq etemp-bk (dxf -2 (tblsearch "BLOCK" bk-name))
  91.       )
  92.    )
  93.    (while (/= (dxf 0 (entget etemp-bk)) "ATTDEF")
  94.       (setq etemp-bk (entnext etemp-bk))
  95.    )      
  96.    (setq att-prmt (dxf 3 (entget etemp-bk))
  97.          att-str (strcat "***Attribute Prompt:  " att-prmt)
  98.          etemp-bk (entnext etemp-bk)
  99.    )
  100. ) 
  101. ;-------------------------------AT-VALUE--------------------------------------
  102. (defun at-value ()
  103.    (if (= etemp2 nil)
  104.       (setq etemp2 (entnext etemp)
  105.             at-val (dxf 1 (entget etemp2))
  106.       )
  107.       (setq etemp2 (entnext etemp2)
  108.             at-val (dxf 1 (entget etemp2))
  109.       )
  110.    )
  111. )
  112. ;-------------------------------AT-FILE---------------------------------------
  113. (defun at-file ()
  114.    (setq at-fil (open "attexted.fil" "a"))
  115.    (write-line att-str at-fil)
  116.    (write-line at-val at-fil)
  117.    (close at-fil)
  118. )
  119. ;-------------------------------AT-FIX----------------------------------------
  120. (defun at-fix ( / etemp elist etemp2 elist2 str-test at-new old new at-fil)
  121.    (setq ss-ctr 0
  122.          at-fil (open "attexted.fil" "r")
  123.    )
  124.    (while (< ss-ctr at-sslgth)
  125.       (setq etemp (ssname ss1 ss-ctr)
  126.             elist (entget etemp)
  127.             etemp2 (entnext etemp)
  128.             elist2 (entget etemp2)
  129.       )
  130.       (while (and (= "ATTRIB" (dxf 0 elist2)) (/= "SEQEND" (dxf 0 elist2)))
  131.          (setq str-test (read-line at-fil))
  132.          (while str-test
  133.             (if (= (substr str-test 1 3) "***")
  134.                (setq str-test (read-line at-fil))
  135.                (setq at-new str-test
  136.                      str-test nil
  137.                )
  138.             )
  139.          )
  140.          (setq old (assoc 1 elist2)
  141.                new (cons 1 at-new)
  142.                elist2 (subst new old elist2)
  143.          )
  144.          (entmod elist2)
  145.          (setq etemp2 (entnext etemp2)
  146.                elist2 (entget etemp2)
  147.          )
  148.       )
  149.       (setq ss-ctr (1+ ss-ctr))
  150.    )
  151.    (close at-fil)
  152. )
  153. ;-----------------------------------------------------------------------------
  154. ;*****************************U T I L I T I E S*******************************
  155. ;-----------------------------------------------------------------------------
  156. (defun s1 ()
  157.    (setq cmd-ex (getvar "cmdecho"))
  158.    (setvar "cmdecho" 0)
  159. )
  160. ;-----------------------------------------------------------------------------
  161. (defun s2 ()
  162.    (setvar "cmdecho" cmd-ex)
  163.    (prompt "\nProgram Completed...")
  164. )
  165. ;-----------------------------------------------------------------------------
  166. (defun dxf (code e-list)
  167.    (cdr (assoc code e-list))
  168. )
  169. ;-----------------------------------------------------------------------------
  170. (defun f-test ()
  171.    (if (/= (findfile "attexted.fil") nil)
  172.       (progn
  173.          (prompt "\nErasing existing file...\n")
  174.          (command "DEL" "attexted.fil")
  175.       )
  176.    )
  177. )
  178. ;-----------------------------------------------------------------------------
  179. ;*************************E R R O R   H A N D L I N G*************************
  180. ;-----------------------------------------------------------------------------
  181. ;---------------------------------BK-TST--------------------------------------
  182. (defun bk-tst ( / b-el b-en blk-ok)
  183.    (setq ss-ctr 0
  184.          blk-ok 0
  185.    )
  186.    (prompt "\nChecking selection set . . .")
  187.    (while (< ss-ctr at-sslgth)
  188.       (bk-info)
  189.       (setq etemp-bk (dxf -2 (tblsearch "BLOCK" bk-name))
  190.             b-en etemp-bk
  191.       )
  192.       (while b-en
  193.          (setq b-el (entget b-en))
  194.          (if (and (= (dxf 70 b-el) 2)               
  195.                 (= (dxf 0 b-el) "ATTDEF")
  196.              )
  197.             (setq blk-ok (1+ blk-ok))
  198.          )
  199.          (setq b-en (entnext b-en))
  200.       )
  201.       (if (/= blk-ok 0) (out)        ;causes null function for error
  202.          (prompt " .")
  203.       )
  204.       (setq ss-ctr (1+ ss-ctr))  
  205.    )
  206.    (prompt " O.K.")
  207.    (princ)
  208. )
  209. ;---------------------------------AT-ERR--------------------------------------
  210. (defun at-err (m)
  211.    (cond
  212.       ((= m "null function")
  213.          (prompt "\nerror:  Blocks cannot contain CONSTANT attributes")
  214.          (setq *error* olderr)
  215.          (princ)
  216.       )
  217.       ((= m "Function cancelled")
  218.       (prompt "\n\n\nUser cancelled function")
  219.       (setq *error* olderr)
  220.       )
  221.       ((/= m nil)
  222.          (prompt "\nerror:  ")
  223.          (princ m)
  224.          (prompt "\nObjects selected possibly not blocks or don't have attributes")
  225.          (setq *error* olderr)
  226.          (princ)
  227.       )
  228.    )
  229.    (princ)
  230. )
  231. ;---------------------------------ERR-SET-------------------------------------
  232. (defun errset ()
  233.    (setq olderr *error*
  234.          *error* at-err
  235.    )
  236. )
  237. ;---------------------------------ERR-B4--------------------------------------
  238. (defun err-b4 ()
  239.    (setq *error* olderr)
  240. )
  241.  
  242.